perm filename CONNEW.F4[COL,LCS] blob
sn#104313 filedate 1974-05-25 generic text, type T, neo UTF8
C *******CONVERTS FROM MAGTAPE OR 2314 TO UDP OR 2314 ***********
C DEC 17,1970 ********* CONVERTS 18 (AND 12) BIT .DMD FILES ***********
C CONVERTS .DMD FILES WRITTEN WITH RCDFLG←1; OR BIGBIT←1;(or ←2;)
C LOAD WITH CVTIO.REL AND NORM.REL.
C TYPE 'X' IF FINAL NAME UNKNOWN OR IF DATA GOES BEYOND CURRENT TAPE.
C 1ST NAME OF EACH PAIR TYPED BY COMPUTER IS BASED ON NAME #1 YOU TYPED.
C 2ND IS ACTUAL NAME OF FILE.
C IF NO MAXAMP IS TYPED AFTER NAME #1, IT WILL BE REQUESTED LATER.
C TO BACK UP TYPE '-1'. 'REWIND' MAY BE TYPED AFTER 'MTA0' OR 'NAME #1'.
C USE 'TAPMUS' TO ADVANCE TAPE IF NEEDED.
DIMENSION JSB(128),IBOTT(4096)
100 FORMAT(' TYPE NAME #1'/)
200 FORMAT(' TYPE FINAL NAME'/)
250 FORMAT(A1)
300 FORMAT(2XA5,2XI4,I9)
400 FORMAT(A5,2I)
450 FORMAT(' READ FROM MTA0?'/)
500 FORMAT(I,' WORDS, FACTOR=',F6.3,', MAXAMP=',I4/)
600 FORMAT(' MORE??'/)
700 FORMAT(' TYPE MAXAMP'/)
800 FORMAT(4I)
EQUIVALENCE (JSB(2),JSB2),(JSB(3),JSB3),(JSB(4),JSB4)
MUSIC='MUSIC'
CALL PUTMUS(MUSIC)
FACTOR=1.
N=9000
JUDP=4
C GARPLY READS 4*1024 WDS.
JSIZE=1024
101 KSIZE=JSIZE
MX=0
KCNT=0
IX=0
JA=1
440 TYPE 450
ACCEPT 250,TAPE
IF(TAPE.NE.'R')GO TO 54
REWIND 16
TAPE='Y'
54 TYPE 100
JNM='AAAAA'
ACCEPT 400,NAME,MAXAMP
IF(MAXAMP.EQ.0)MAXAMP=MX
IF(NAME.EQ.'-1')GO TO 440
IF(NAME.EQ.'NO')GO TO 1201
C CAN TYPE 'NO' IF MISTAKE EARLIER.
IF(NAME.EQ.' ')NAME='MUSAA'
2 JNM=JNM+((NAME-JNM)/256*256)
KNM=JNM
C AUTOMATICALLY SETS BASIC NAME TO 'A' ENDING. 12-BIT SOUND NOT NORMALIZED.
1002 TYPE 200
ACCEPT 400,NM2,KSKIP
IF(NM2.EQ.'-1')GO TO 54
IF(NM2.EQ.' ')NM2=NAME
IF(TAPE.NE.'Y')GO TO 7077
IF(MAXAMP.NE.0)GO TO 2710
TYPE 700
ACCEPT 800,MAXAMP
IF(MAXAMP)GO TO 54
IX=0
2710 IF(NM2.EQ.' ')NM2=NAME
1710 CALL GETTAP
1810 CALL INTAPE(JSB(1),128)
IF(JSB(1))GO TO 1202
TYPE 300,JSB3
IF(IX.OR.JSB2.EQ.3)GO TO 2022
IF(MAXAMP.EQ.0)MAXAMP=2040
GO TO 199
7077 IF(MAXAMP.NE.0)GO TO 4022
CALL GETFIL(NM2)
CALL FASTIN(JSB(1),128)
IF(JSB2.EQ.3)GO TO 4022
JSC=JSB(1)
6066 CALL FASTIN(IBOTT(1),JSC)
IF(IBOTT(JSC).EQ.0)GO TO 6066
MAXAMP=IABS(IBOTT(JSC))
4022 IF(N)GO TO 710
N=-2
IF(JSB2.EQ.3)GO TO 710
199 FACTOR=2040./MAXAMP
MX=MAXAMP
IX=-1
KSIZE=3*JSIZE/2
IF(TAPE.EQ.'Y')GO TO 2022
C AMPL. WILL BE NEG. IF LSBUF WAS NOT FULL (LAST BUFFER).
710 IF(TAPE.EQ.'Y')GO TO 1810
CALL GETFIL(NAME)
810 CALL FASTIN(JSB(1),128)
IF(JSB2.EQ.3)IX=0
2022 JSC=JSB(1)
1022 IF(JA.GT.KSIZE)GO TO 17
610 IF(TAPE.NE.'Y')CALL FASTIN(IBOTT(JA),JSC)
IF(TAPE.EQ.'Y')CALL INTAPE(IBOTT(JA),JSC)
C LAST WORD IS THROWN AWAY.
JA=JA+JSC-1
JC=IBOTT(JA)
IF(JC)5,1022,6
5 JA=JA-IBOTT(JA-1)
6 TYPE 300,NAME,JC,KCNT
NAME=NAME+2
IF(NAME.LE.JNM+50)GO TO 27
JNM=JNM+256
IF(JNM.LE.KNM+6400)GO TO 1017
KNM=JNM+26112
JNM=KNM
C RAISES 'AAAZA' TO 'AABAA'
1017 NAME=JNM
27 IF(NAME.LE.NM2)GO TO 710
1202 TYPE 600
ACCEPT 400,NAME
IF(NAME.EQ.'YES'.OR.NAME.EQ.'Y')GO TO 440
1201 NM2=NAME-1
17 JC=JA-1
IF(JC.LT.KSIZE)GO TO 23
10 IF(IX)CALL NORM(IBOTT(1),KSIZE,FACTOR)
LSIZE=KSIZE
JMP=-1
32 KCNT=KCNT+JSIZE
CALL FSTMUS(IBOTT(1),JSIZE)
IF(JMP)7,8,9
7 JC=JC-LSIZE
DO 12 K=1,JC
12 IBOTT(K)=IBOTT(K+LSIZE)
JA=JC+1
IF(JC.GT.KSIZE)GO TO 10
IF(NAME.LE.NM2)GO TO 610
23 IF(IX.EQ.0)GO TO 43
CALL NORM(IBOTT(1),JC,FACTOR)
JC=JC*2/3
43 DO 13 K=JC+1,JSIZE
13 IBOTT(K)=0
JMP=0
GO TO 32
8 DO 14 K=1,JSIZE
14 IBOTT(K)=0
JMP=1
GO TO 32
9 K=KCNT/JSIZE
L=K-(K/JUDP)*JUDP
IF(L.EQ.0)GO TO 3222
DO 4222 K=1,JSIZE
4222 IBOTT(K)=0
DO 6222 K=1,L
6222 CALL FSTMUS(IBOTT(1),JSIZE)
KCNT=KCNT+L*JSIZE
3222 CALL FINMUS
7222 TYPE 500,KCNT,FACTOR,MAXAMP
END